!!M Inlines.f
!!G AEvent.finc
c
c
	program Array_process

	implicit none
	
	external get_array
	integer*2 err
	
	err = AEInstallEventHandler (%val('JLMT'),%val('MULT'),%val(%loc(get_array)),%val(int4(0)),%val(int2(0))) 
	if (err. ne. 0) call alertbox('Array_process: Apple Event install error')

	do while (.true.)
		call F_DoBackground
	end do
	
	end

	integer*2 function get_array(theAppleEvent,reply,%val(handlerRefCon))
	implicit none
	
	record /AppleEvent/ theAppleEvent
	record /AppleEvent/ reply
	integer*4 handlerRefCon
	
	integer*2 err
	integer*4 keywd,returnedType,actualSize
	
	real*4 myarray(10000)

	integer xdim,ydim
	global xdim,ydim,myarray
	
	integer totalsize
	
	err = AEGetParamPtr(%ref(theAppleEvent),%val('XDIM'),%val(typeInteger),
	1		returnedType,%val(%loc(xdim)),%val(sizeof(xdim)),actualSize)
	if (err	.ne. 0) goto 9999
	
	err = AEGetParamPtr(%ref(theAppleEvent),%val('YDIM'),%val(typeInteger),
	1		returnedType,%val(%loc(ydim)),%val(sizeof(ydim)),actualSize)
	if (err	.ne. 0) goto 9999
	
	totalsize = xdim * ydim * 4
	
	err = AEGetParamPtr(%ref(theAppleEvent),%val('ARRY'),%val(typeChar),
	1		returnedType,%val(%loc(myarray)),%val(totalsize),actualSize)
	if (err	.ne. 0) goto 9999

c	we don't check whether actualSize = totalsize and returnedType = typeChar.
c
c	In an actual application, such errors have to be trapped, of course.
c

	call process_array(myarray,xdim,ydim)
	
	err = AEPutParamPtr(%ref(reply),%val('XDIM'),%val(typeInteger),
	1		%val(%loc(xdim)),%val(sizeof(xdim)))
	if (err	.ne. 0) goto 9999
	
	err = AEPutParamPtr(%ref(reply),%val('YDIM'),%val(typeInteger),
	1		%val(%loc(ydim)),%val(sizeof(ydim)))
	if (err	.ne. 0) goto 9999
	
	err = AEPutParamPtr(%ref(reply),%val('ARRY'),%val(typeChar),
	1		%val(%loc(myarray)),%val(totalsize))
	if (err	.ne. 0) goto 9999
	
	get_array = 0	! noErr
	return

9999  get_array = err
	return
		
	end


	subroutine process_array(array,xdim,ydim)
	integer xdim,ydim
	real*4 array(xdim,ydim)
	
	do i=1,xdim
		do j=1,ydim
		array(i,j) = array(i,j)*array(i,j)/10000.
		end do
	end do
	
	return
	end
